home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok23.lha / Intro / Intro.MOD < prev    next >
Encoding:
Text File  |  1993-08-16  |  10.7 KB  |  359 lines
  1. (*******************************************************************************
  2.  :Program.         Intro.MOD
  3.  :Author.          Carsten Wartmann
  4.  :Address.         Wutzkyallee 83, D-1000 Berlin 47
  5.  :Phone.           030/6614776
  6.  :Version.         1.5
  7.  :Date.            4/89
  8.  :Copyright.       PD
  9.  :Language.        Modula-2
  10.  :Compiler.        M2Amiga V3.2d
  11.  :Contents.        Demo of Sprites, Copper, Scrolltext in Modula-2
  12. *******************************************************************************)
  13.  
  14. (* For more infos see Intro.DOC                                               *)
  15.  
  16. MODULE Intro ; (* $R- $V- $S- *) (* Achtung ! Vor Änderungen entfernen ! *)
  17.  
  18.  
  19. FROM SYSTEM       IMPORT BITSET,ADR,FFP,ADDRESS,INLINE,SHIFT ;
  20.  
  21. FROM Arts         IMPORT Assert ;
  22.  
  23. FROM Intuition    IMPORT NewScreen,ScreenPtr,OpenScreen,CloseScreen,
  24.                          customScreen,NewWindow,WindowPtr,SetPointer,
  25.                          IDCMPFlags,IDCMPFlagSet,WindowFlags,WindowFlagSet,
  26.                          OpenWindow,CloseWindow,RethinkDisplay ;
  27.  
  28. FROM Graphics     IMPORT ViewModes,ViewModeSet,SetAPen,RastPortPtr,ClearScreen,
  29.                          LoadRGB4,Move,RastPort,WritePixel,Draw,GetSprite,
  30.                          FreeSprite,MoveSprite,SimpleSpritePtr,UCopList,
  31.                          Text,RectFill,BltBitMap,ScrollRaster,ReadPixel ;
  32.  
  33. FROM GfxMacros    IMPORT CINIT,CMOVE,CWAIT,CEND ;
  34.  
  35. FROM Exec         IMPORT AllocMem,FreeMem,MemReqs,MemReqSet,CopyMem,
  36.                          Forbid,Permit ;
  37.  
  38. FROM MathLibFFP   IMPORT sin,cos,pi ;
  39.  
  40. FROM Str          IMPORT Concat ;
  41.  
  42.  
  43. CONST Punkte  = 720   ;
  44.       Punkte1 = 720.0 ;       (*Is` ne` Krücke*)
  45.  
  46. TYPE SpriteStruc = RECORD
  47.                       SpriteData : ADDRESS ;
  48.                       height     : INTEGER ;
  49.                       xpos       : INTEGER ;
  50.                       ypos       : INTEGER ;
  51.                       num        : INTEGER ;
  52.                    END ;
  53.  
  54.  
  55. VAR screen                  : NewScreen ;
  56.     screenptr               : ScreenPtr ;
  57.     window                  : NewWindow ;
  58.     windowptr               : WindowPtr ;
  59.     drawRP                  : RastPortPtr ;
  60.     viewP,ucopl,fbitmap,
  61.     mousemem                : ADDRESS ;
  62.     cia[0BFE000H]           : BITSET ;
  63.     fehler,t,i,ii,sprite,
  64.     charnr,row              : INTEGER ;
  65.     cx,cy                   : ARRAY [0..Punkte] OF INTEGER ;
  66.     chipmem,data            : ADDRESS ;
  67.     spritess                : ARRAY [0..7] OF SpriteStruc ;
  68.     stext,stext1            : ARRAY [0..150] OF CHAR ;
  69.  
  70.  
  71. PROCEDURE Sprite ; (*$E-*)
  72.  
  73.    BEGIN (* Spritedaten, müssen noch ins CHIP-RAM !               *)
  74.          (* für jedes Sprite einzeln auch bei gleichem Aussehen ! *)
  75.  
  76.       INLINE (
  77.               00000H,00000H,  (*Startworte mit X,Y etc...  *)
  78.               004C0H,003C0H,018B0H,007F0H,03B18H,007F8H,078F4H,007FCH,
  79.               077B8H,008FCH,0FACAH,005FEH,0C244H,03DFEH,0F206H,00DFEH,
  80.               0E27EH,01DFEH,0F58CH,00AFEH,0764CH,009BCH,07AC0H,0053CH,
  81.               03E70H,00198H,01FC0H,00030H,007C0H,00000H,00000H,00000H,
  82.               00000H,00000H,  (*Stopworte für Sprite-DMA...*)
  83.               00000H,00000H,
  84.               004C0H,003C0H,018B0H,007F0H,03B18H,007F8H,078F4H,007FCH,
  85.               077B8H,008FCH,0FACAH,005FEH,0C244H,03DFEH,0F206H,00DFEH,
  86.               0E27EH,01DFEH,0F58CH,00AFEH,0764CH,009BCH,07AC0H,0053CH,
  87.               03E70H,00198H,01FC0H,00030H,007C0H,00000H,00000H,00000H,
  88.               00000H,00000H,
  89.               00000H,00000H,
  90.               004C0H,003C0H,018B0H,007F0H,03B18H,007F8H,078F4H,007FCH,
  91.               077B8H,008FCH,0FACAH,005FEH,0C244H,03DFEH,0F206H,00DFEH,
  92.               0E27EH,01DFEH,0F58CH,00AFEH,0764CH,009BCH,07AC0H,0053CH,
  93.               03E70H,00198H,01FC0H,00030H,007C0H,00000H,00000H,00000H,
  94.               00000H,00000H,
  95.               00000H,00000H,
  96.               004C0H,003C0H,018B0H,007F0H,03B18H,007F8H,078F4H,007FCH,
  97.               077B8H,008FCH,0FACAH,005FEH,0C244H,03DFEH,0F206H,00DFEH,
  98.               0E27EH,01DFEH,0F58CH,00AFEH,0764CH,009BCH,07AC0H,0053CH,
  99.               03E70H,00198H,01FC0H,00030H,007C0H,00000H,00000H,00000H,
  100.               00000H,00000H,
  101.               00000H,00000H,
  102.               004C0H,003C0H,018B0H,007F0H,03B18H,007F8H,078F4H,007FCH,
  103.               077B8H,008FCH,0FACAH,005FEH,0C244H,03DFEH,0F206H,00DFEH,
  104.               0E27EH,01DFEH,0F58CH,00AFEH,0764CH,009BCH,07AC0H,0053CH,
  105.               03E70H,00198H,01FC0H,00030H,007C0H,00000H,00000H,00000H,
  106.               00000H,00000H,
  107.               00000H,00000H,
  108.               004C0H,003C0H,018B0H,007F0H,03B18H,007F8H,078F4H,007FCH,
  109.               077B8H,008FCH,0FACAH,005FEH,0C244H,03DFEH,0F206H,00DFEH,
  110.               0E27EH,01DFEH,0F58CH,00AFEH,0764CH,009BCH,07AC0H,0053CH,
  111.               03E70H,00198H,01FC0H,00030H,007C0H,00000H,00000H,00000H,
  112.               00000H,00000H
  113.             ) ;
  114.  
  115. END Sprite ;
  116.  
  117. PROCEDURE RGB ; (*$E-*)
  118.  
  119.    BEGIN (* Farbwerte fuer die Sprites *)
  120.  
  121.       INLINE(0000H,0000H,03F0H,05D0H,07B0H,0990H,0B70H,0D50H,
  122.              0F30H,0000H,0000H,0000H,0000H,0000H,0000H,0000H,
  123.              0000H,0000H,0000H,0000H,0000H,0002H,0006H,000BH,
  124.              0000H,0004H,0008H,000DH,0000H,0006H,000AH,000FH)
  125.  
  126. END RGB ;
  127.  
  128. PROCEDURE MakeUCopL ;
  129.  
  130. VAR i,spr0pth,spr0ptl : INTEGER ;
  131.  
  132.    BEGIN (* Errechnen der User-Copper-Liste *)
  133.  
  134.       (* Die CL sorgt auch dafür, daß der Mauszeiger ausgeschaltet     *)
  135.       (* wird, denn mit SetPointer funktioniert mit einer UCL zusammen *)
  136.       (* nicht ! Durch die CL wird immer wieder der alte Wert gelesen  *)
  137.       spr0pth := INTEGER(SHIFT(mousemem,-8)) ;
  138.       spr0ptl := INTEGER(SHIFT(SHIFT(mousemem,8),-8)) ;
  139.  
  140.       CMOVE(ucopl,0120H,spr0pth) ; (* Ausschalten des Mauszeigers *)
  141.       CMOVE(ucopl,0122H,spr0pth) ;
  142.  
  143.       FOR i := 0 TO 255 DO
  144.  
  145.          CWAIT(ucopl,i,14) ;
  146.          CMOVE(ucopl,0DFF180H,i*8+i*4+i*2+i) ;
  147.  
  148.       END (*FOR*) ;
  149.  
  150.       CEND(ucopl,254,255) ; (* Unsinniger Befehl zeigt das Ende d. CL *)
  151.  
  152.       screenptr^.viewPort.uCopIns := ucopl ;
  153.  
  154.       RethinkDisplay() ;
  155.  
  156. END MakeUCopL ;
  157.  
  158.  
  159. PROCEDURE OpenAll ;
  160.  
  161.    BEGIN (* Öffnen des Screens, Windows und Alloziieren des Speichers *)
  162.  
  163.       WITH screen DO
  164.  
  165.          leftEdge     := 0 ;
  166.          topEdge      := 0 ;
  167.          width        := 640 ;
  168.          height       := 256 ;
  169.          depth        := 2 ;
  170.          viewModes    := ViewModeSet{sprites,hires} ;
  171.          type         := customScreen ;
  172.          font         := NIL ;
  173.          defaultTitle := NIL ;
  174.          gadgets      := NIL ;
  175.          customBitMap := NIL ;
  176.  
  177.       END (*WITH*) ;
  178.  
  179.       screenptr := OpenScreen(screen) ;
  180.       Assert(screenptr # NIL,ADR("Screen is nix")) ;
  181.  
  182.       WITH window DO
  183.  
  184.          leftEdge    := 0 ;
  185.          topEdge     := 0 ;
  186.          width       := 640 ;
  187.          height      := 256 ;
  188.          detailPen   := 0 ;
  189.          blockPen    := 1 ;
  190.          idcmpFlags  := IDCMPFlagSet{} ;
  191.          flags       := WindowFlagSet{borderless} ;
  192.          firstGadget := NIL ;
  193.          checkMark   := NIL ;
  194.          title       := NIL ;
  195.          screen      := screenptr ;
  196.          bitMap      := NIL ;
  197.          type        := customScreen ;
  198.  
  199.       END (*WITH*) ;
  200.  
  201.       windowptr := OpenWindow(window) ;
  202.       Assert(windowptr # NIL,ADR("Window is nix")) ;
  203.  
  204.       drawRP := windowptr^.rPort ;
  205.       viewP  := ADR(screenptr^.viewPort) ;
  206.  
  207.       chipmem := AllocMem(512,MemReqSet{chip,memClear}) ;
  208.       Assert(chipmem # NIL,ADR("No ChipMem for Sprites aviable !")) ;
  209.  
  210.       (* ACHTUNG ! Das Mem für die UCopList darf nicht wieder          *)
  211.       (* freigegeben werden, das macht das System, sonst GURU (81...9) *)
  212.       ucopl   := AllocMem(SIZE(UCopList),MemReqSet{chip,memClear}) ;
  213.       Assert(ucopl # NIL,ADR("No ChipMem for UCopL aviable !")) ;
  214.  
  215.       mousemem := AllocMem(16,MemReqSet{chip,memClear}) ;
  216.       Assert(mousemem # NIL,ADR("No ChipMem for NILPointer aviable !")) ;
  217.  
  218.       LoadRGB4(viewP,ADR(RGB),32) ; (* Einlesen der Farbwerte *)
  219.  
  220.       CopyMem(ADR(Sprite),chipmem,72*6) ; (*Kopieren der Grafik ins CHIP *)
  221.  
  222.       FOR sprite := 2 TO 7 DO             (* Initialisieren der Sprites *)
  223.  
  224.          WITH spritess[sprite] DO
  225.  
  226.             data := chipmem ;
  227.             INC(data,72*(sprite-2)) ;
  228.  
  229.             SpriteData := data ;
  230.             height     := 16 ;
  231.             xpos       := 0 ;
  232.             ypos       := 0 ;
  233.             num        := sprite ;
  234.  
  235.          END (*WITH*) ;
  236.  
  237.          i := GetSprite(ADR(spritess[sprite]),sprite) ;
  238.  
  239.      END (*FOR sprite*) ;
  240.  
  241.      MakeUCopL ;
  242.  
  243. END OpenAll ;
  244.  
  245.  
  246. PROCEDURE PlotCourse ;
  247.  
  248. VAR x,y,rad        : FFP ;
  249.     xbild,ybild,
  250.     winkel,fehler  : INTEGER ;
  251.  
  252.  
  253.    BEGIN (* Errechnen des Kurses *)
  254.  
  255.       FOR winkel := 0 TO Punkte DO
  256.  
  257.          rad := (FFP(winkel)) / (Punkte1/360.0) * pi / 180.0 ;
  258.  
  259.          x := sin(4.0*rad) ;   (* Lissajous-Figur ! *)
  260.          y := cos(5.0*rad) ;
  261.  
  262.          xbild := 320 + TRUNC(x * 290.0) ;
  263.          ybild := 120 - TRUNC(y * 110.0) ;
  264.  
  265.          (*fehler := WritePixel(drawRP,xbild,ybild) ;*)
  266.          (*Kommentar entfernen, wenn der Kurs gezeichnet werden soll*)
  267.  
  268.          cx[winkel] := xbild - 4 ;
  269.          cy[winkel] := ybild - 4 ;
  270.  
  271.       END (*FOR winkel*) ;
  272.  
  273. END PlotCourse ;
  274.  
  275.  
  276. PROCEDURE CopyRow(row : INTEGER) ;
  277.  
  278. VAR y,dummy : INTEGER ;
  279.  
  280.    BEGIN (* Ich hatte leider Probleme mit BltBitMap...*)
  281.  
  282.       FOR y := 0 TO 7 DO
  283.  
  284.             SetAPen(drawRP,ReadPixel(drawRP,row,y)) ;
  285.             RectFill(drawRP,636,110+y*4,640,114+y*4) ;
  286.  
  287.       END (*FOR*) ;
  288.  
  289. END CopyRow ;
  290.  
  291.  
  292. BEGIN (* Hauptprogramm *)
  293.  
  294.    stext  := "Hi, this is a Scrolltext....So what ?...Not for a cracked game," ;
  295.    stext1 := " only a Modula-2 demo of using sprites, copper and scrolling..." ;
  296.  
  297.    Concat(stext,stext1) ; (* Fügt die Texte zu einem String zuasammen *)
  298.  
  299.    OpenAll ;
  300.  
  301.    PlotCourse ;
  302.  
  303.    Forbid() ;       (* Sorgt fuer einen flüssigen Ablauf *)
  304.  
  305.    LOOP (* Hauptschleife *)
  306.  
  307.       FOR i := 0 TO Punkte DO
  308.  
  309.          FOR sprite := 2 TO 7 DO (* Alle Sprites setzen *)
  310.  
  311.             ii := (i + (sprite-1) * 5) MOD Punkte ;
  312.  
  313.             MoveSprite(viewP,ADR(spritess[sprite]),cx[ii],cy[ii]) ;
  314.  
  315.          END (*FOR sprite*) ;
  316.  
  317.          (* Ab hier beginnt die Textdarstellung (siehe DOC) *)
  318.  
  319.          SetAPen(drawRP,1) ;
  320.          Move(drawRP,0,6) ;
  321.          Text(drawRP,ADR(stext[charnr]),1) ;
  322.  
  323.          CopyRow(row) ;
  324.          ScrollRaster(drawRP,4,0,0,110,640,150) ;
  325.  
  326.          INC(row) ;
  327.  
  328.          IF row>7 THEN
  329.             INC(charnr) ;
  330.             IF charnr>125 THEN
  331.                charnr := 0 ;
  332.             END (*IF*) ;
  333.             row := 0 ;
  334.          END (*IF*) ;
  335.  
  336.          IF NOT(6 IN cia) THEN (* Solange bis linker Mausknopf gerdrückt *)
  337.             EXIT ;
  338.          END (*IF*) ;
  339.  
  340.       END (*FOR i*) ;
  341.  
  342.    END (*WHILE*) ;
  343.  
  344.    Permit() ; (* Multitasking ein und die Resourcen zurückgeben *)
  345.  
  346.    CloseWindow(windowptr) ;
  347.    CloseScreen(screenptr) ;
  348.  
  349.    FOR i := 2 TO 7 DO
  350.  
  351.       FreeSprite(i) ;
  352.  
  353.    END (*FOR i*) ;
  354.  
  355.    FreeMem(chipmem,512) ;
  356.    FreeMem(mousemem,16) ;
  357.  
  358. END Intro .
  359.